Subroutine GAMSubs ! !Global variables Use dfwin Use G7AllocMemory Use GEMSS_GAMAllocMemoryVariables Use AllocMemoryWQCBM3DVariables Use AllocMemoryWQADD3DVariables Include 'G7Variables.f90' Include 'GEMSS_GAMVariables.f90' Include 'G7WQADD3DVariables.f90' Character(256) message1, message2 Real(8) Depth, PhytoConc, Depth1 Real(8) d1, Sum Real(8) df1, ftmp, po4avl Real(8) MAlgGrowth, MAlgResp, MAlgDeath, MAlgExrec, MAlgGraze, MAlgSettl Real(8) NH3FromAlg, NH3ToAlg, NO3ToAlg Real(8) PO4FromAlg, PO4ToAlg Real(8) DOFromAlg, DOToAlg Real(8) FCBODFromAlg, SCBODFromAlg, POCFFromAlg, POCSFromAlg, POCRFromAlg Real(8) DONFromAlg, DOPFromAlg, PONFromAlg, POPFromAlg Real(8) GAM3D_ke, stox, Temp20 Real(8) AlgaeGrwthNetLimit Real(8) apc, anc, ancp, apcp, aoc Real(8) fd9f, fg9f, fd9s, fg9s, fd9r, fg9r Integer(2) i, j, nc, k, IntVal1, id, TVRCFileCount, jj, kn Integer(4) n Real(8) Num, Den, Alpha0, Alpha1 Logical(1) ChangesInRegions Real(8) Pam Byte Units Real(8) RateConversion, LightConversion, VelocityConversion Integer(2) NumTVRCFiles, jdd, jd, nci, nj,ni Integer(4) ierr, iretw, DTTM2JULIAN, IStat Byte VersionCheck, BytVal1, BytVal2, BytVal3,d11 Real(8) Value1, Value2, Factor, Value Byte GAM3D_UseTVRCFileLocal Character(256) GAM3D_TVRCFileNameLocal Byte InsideGAM ! !Local variables for Alkalinity, pH and Conductivity Real(8) ralkaa, ralkan, ralkbn, ralkbp, ralkn, ralkden, rondn Real(8) rcca, rcco, rccd, rccc, ralkda, ralkdn, defa Real(8) ph_k1, ph_k2, ph_kw, ph_kh Real(8) alp0, alp1 Real(8) kacT, ron, roa, aca, ph_hh Real(8) CO2Sat ! CO2, HCO3, CO3, TIOC, ALKL Real(8) prefam Common/GAMLocalVariables/& Depth, PhytoConc, Depth1,& Sum,& df1, ftmp, po4avl,& MAlgGrowth, MAlgResp, MAlgDeath, MAlgExrec, MAlgGraze, MAlgSettl,& NH3FromAlg, NH3ToAlg, NO3ToAlg,& PO4FromAlg, PO4ToAlg,& DOFromAlg, DOToAlg,& FCBODFromAlg, SCBODFromAlg, POCFFromAlg, POCSFromAlg, POCRFromAlg,& DONFromAlg, DOPFromAlg, PONFromAlg, POPFromAlg,& GAM3D_ke, stox, Temp20, id,& NumTVRCFiles, jdd, IStat, nci, nj,ni,& ierr, iretw,& VersionCheck, BytVal1, BytVal2,BytVal3,& Value1, Value2, Factor, Value,d11 Common/CommonVariablesBetweenGAMandWQCBM/& apc, anc, ancp, apcp, aoc,& fd9f, fg9f, fd9s, fg9s, fd9r, fg9r, InsideGAM ! ! !This line should be there in all water quality models Common/CommonVariablesForAllWQModels/& i, j, k, n, nc, d1 Common/CommonVariablesBetweenGAMandWQADD3D/& Pam ! !pH Common/CommonVariablesForpH/& ralkaa, ralkan, ralkbn, ralkbp, ralkn, ralkden, rondn,& rcca, rcco, rccd, rccc, ralkda, ralkdn, defa,& ph_k1, ph_k2, ph_kw, ph_kh,& alp0, alp1,& kacT, ron, roa, aca, ph_hh,& CO2Sat,& prefam Data SetTop /0/ Save Return Entry ReadGAMControlFile If(.Not. GenAlgaeModel) Return TVRCFileCount = 0 j = 1 Do While(.true.) read (NFctl,*,end=1000) Message Select Case(message(1:len_trim(message)-1)) ! !Look for iGAM Case('iGAM') BackSpace(NFctl) Read(NFctl,*) message1, message2, IntVal1, IntVal1, IntVal1, NUMGAM3DRegions Call AllocateMemoryForGAMVariables Do i = 1, ngamcs Read(NFctl,'(2(/))') Read(NFctl,*) message1, message2, GAM3D_UseNutrientLimit(j) Read(NFctl,*) message1, message2, GAM3D_UseTempLimit(j) Read(NFctl,*) message1, message2, GAM3D_UseSalineToxicLimit(j) Read(NFctl,*) message1, message2, GAM3D_UseLightLimit(j) Read(NFctl,*) message1, message2, GAM3D_k1r(i,j), Units GAM3D_k1r(i,j) = RateConversion(GAM3D_k1r(i,j), Units) Read(NFctl,*) message1, message2, GAM3D_Tht_k1r(i,j) Read(NFctl,*) message1, message2, GAM3D_k1c(i,j), Units GAM3D_k1c(i,j) = RateConversion(GAM3D_k1c(i,j), Units) Read(NFctl,*) message1, message2, GAM3D_Tht_k1c(i,j) Read(NFctl,*) message1, message2, GAM3D_k1d(i,j) GAM3D_k1d(i,j) = RateConversion(GAM3D_k1d(i,j), Units) Read(NFctl,*) message1, message2, GAM3D_fe(i,j) Read(NFctl,*) message1, message2, GAM3D_as(i,j) Read(NFctl,*) message1, message2, GAM3D_ws(i,j), Units GAM3D_ws(i,j) = VelocityConversion(GAM3D_ws(i,j), Units) Read(NFctl,*) message1, message2, GAM3D_ZPGMode(i,j) Read(NFctl,*) message1, message2, GAM3D_kgmicro(i,j), Units GAM3D_kgmicro(i,j) = RateConversion(GAM3D_kgmicro(i,j), Units) Read(NFctl,*) message1, message2, GAM3D_Tht_kgmicro(i,j) Read(NFctl,*) message1, message2, GAM3D_kgmacro(i,j), Units GAM3D_kgmacro(i,j) = RateConversion(GAM3D_kgmacro(i,j), Units) Read(NFctl,*) message1, message2, GAM3D_Tht_kgmacro(i,j) Read(NFctl,*) message1, message2, GAM3D_cchl(i,j) Read(NFctl,*) message1, message2, GAM3D_LightModel(i,j) Read(NFctl,*) message1, message2, GAM3D_kke(i,j) Read(NFctl,*) message1, message2, GAM3D_kechl(i,j) Read(NFctl,*) message1, message2, GAM3D_ISat(i,j), Units GAM3D_ISat(i,j) = LightConversion(GAM3D_ISat(i,j),Units) Read(NFctl,*) message1, message2, GAM3D_khn(i,j) Read(NFctl,*) message1, message2, GAM3D_khp(i,j) Read(NFctl,*) message1, message2, GAM3D_stMethod(i,j) Read(NFctl,*) message1, message2, GAM3D_stf(i,j), Units ! !Ambrose Bug Fix: GAM3D_stf(i,j) = RateConversion(GAM3D_stf(i,j), Units) Read(NFctl,*) message1, message2, GAM3D_khst(i,j) Read(NFctl,*) message1, message2, GAM3D_tm(i,j) Read(NFctl,*) message1, message2, GAM3D_ktg1(i,j) Read(NFctl,*) message1, message2, GAM3D_ktg2(i,j) Read(NFctl,*) message1, message2, GAM3D_fd5(i,j) Read(NFctl,*) message1, message2, GAM3D_fon(i,j) Read(NFctl,*) message1, message2, GAM3D_fop(i,j) Read(NFctl,*) message1, message2, GAM3D_foc(i,j) End Do ! !VSK 05-02-2005;VSK 06-07-2010 Read(NFctl,'(//)') Read(NFctl,*) message1, message2, GAM3D_UseTVRCFileLocal !GAM3D_UseTVRCFile(j) Read(NFctl,*) message1, message2, GAM3D_TVRCFileNameLocal !GAM3D_TVRCFileName(j) Exit End Select End Do ! !Use region rates and constants Read(NFctl,*) message1, NUMGAM3DRegions TVRCFileCount = TVRCFileCount + 1 GAM3D_NumTVRCFiles = NumGAM3DRegions + 1 If(GAM3D_NumTVRCFiles /= 0) Then Allocate(GAM3D_UseTVRCFile(GAM3D_NumTVRCFiles), Stat = AllocError) Allocate(GAM3D_TVRCFileName(GAM3D_NumTVRCFiles), Stat = AllocError) Allocate(NFGAM3D(GAM3D_NumTVRCFiles), Stat = AllocError) Allocate(GAM3DRegionName(NumGAM3DRegions), Stat = AllocError) End If GAM3D_TVRCFileName(1) = GAM3D_TVRCFileNameLocal GAM3D_UseTVRCFile(1) = GAM3D_UseTVRCFileLocal If(NUMGAM3DRegions > 0) Then Allocate (GAM3DIStart(NUMGAM3DRegions), GAM3DJStart(NUMGAM3DRegions), Stat = AllocError) Allocate(GAM3DIEnd(NUMGAM3DRegions), GAM3DJEnd(NUMGAM3DRegions), Stat = AllocError) Allocate(GAM3DRegionStatus(im+1,jm+1), Stat = AllocError) Allocate(GAM3DRegionName(NUMGAM3DRegions), Stat = AllocError) Allocate(GAM3DRegionRCDStatus(NumGAM3DRegions), Stat = AllocError) GAM3DRegionRCDStatus = 0 GAM3DRegionStatus = 0 GAM3DIStart = 0 GAM3DJStart = 0 GAM3DIEnd = 0 GAM3DJEnd = 0 End If ChangesInRegions = .False. Do k = 1, NUMGAM3DRegions Read(NFctl,*) GAM3DRegionName(k), GAM3DIStart(k), GAM3DIEnd(k), GAM3DJStart(k), GAM3DJEnd(k), i, j, GAM3DRegionRCDStatus(k) Do i = GAM3DIStart(k)+1,GAM3DIEnd(k)+1 Do j = GAM3DJStart(k)+1,GAM3DJEnd(k)+1 GAM3DRegionStatus(i,j) = k End Do End Do If(GAM3DRegionRCDStatus(k) == 1) Then ChangesInRegions = .True. End If End Do If(.Not. ChangesInRegions) NUMGAM3DRegions = 0 Do jj = 1, NUMGAM3DRegions Read(NFctl,*) message1, message, message j = jj + 1 Do i = 1, ngamcs Read(NFctl,'(2(/))') ! !Skip switches as there is no need to read them for different regions Read(NFctl,*) message1, message2, GAM3D_UseNutrientLimit(j) Read(NFctl,*) message1, message2, GAM3D_UseTempLimit(j) Read(NFctl,*) message1, message2, GAM3D_UseSalineToxicLimit(j) Read(NFctl,*) message1, message2, GAM3D_UseLightLimit(j) Read(NFctl,*) message1, message2, GAM3D_k1r(i,j) GAM3D_k1r(i,j) = RateConversion(GAM3D_k1r(i,j), Units) Read(NFctl,*) message1, message2, GAM3D_Tht_k1r(i,j) Read(NFctl,*) message1, message2, GAM3D_k1c(i,j), Units GAM3D_k1c(i,j) = RateConversion(GAM3D_k1c(i,j), Units) Read(NFctl,*) message1, message2, GAM3D_Tht_k1c(i,j) Read(NFctl,*) message1, message2, GAM3D_k1d(i,j) GAM3D_k1d(i,j) = RateConversion(GAM3D_k1d(i,j), Units) Read(NFctl,*) message1, message2, GAM3D_fe(i,j) Read(NFctl,*) message1, message2, GAM3D_as(i,j) Read(NFctl,*) message1, message2, GAM3D_ws(i,j), Units GAM3D_ws(i,j) = VelocityConversion(GAM3D_ws(i,j), Units) Read(NFctl,*) message1, message2, GAM3D_ZPGMode(i,j) Read(NFctl,*) message1, message2, GAM3D_kgmicro(i,j), Units GAM3D_kgmicro(i,j) = RateConversion(GAM3D_kgmicro(i,j), Units) Read(NFctl,*) message1, message2, GAM3D_Tht_kgmicro(i,j) Read(NFctl,*) message1, message2, GAM3D_kgmacro(i,j), Units GAM3D_kgmacro(i,j) = RateConversion(GAM3D_kgmacro(i,j), Units) Read(NFctl,*) message1, message2, GAM3D_Tht_kgmacro(i,j) Read(NFctl,*) message1, message2, GAM3D_cchl(i,j) Read(NFctl,*) message1, message2, GAM3D_LightModel(i,j) Read(NFctl,*) message1, message2, GAM3D_kke(i,j) Read(NFctl,*) message1, message2, GAM3D_kechl(i,j) Read(NFctl,*) message1, message2, GAM3D_ISat(i,j), Units GAM3D_ISat(i,j) = LightConversion(GAM3D_ISat(i,j),Units) Read(NFctl,*) message1, message2, GAM3D_khn(i,j) Read(NFctl,*) message1, message2, GAM3D_khp(i,j) Read(NFctl,*) message1, message2, GAM3D_stMethod(i,j) Read(NFctl,*) message1, message2, GAM3D_stf(i,j), Units GAM3D_stf(i,j) = RateConversion(GAM3D_stf(i,j), Units) Read(NFctl,*) message1, message2, GAM3D_khst(i,j) Read(NFctl,*) message1, message2, GAM3D_tm(i,j) Read(NFctl,*) message1, message2, GAM3D_ktg1(i,j) Read(NFctl,*) message1, message2, GAM3D_ktg2(i,j) Read(NFctl,*) message1, message2, GAM3D_fd5(i,j) Read(NFctl,*) message1, message2, GAM3D_fon(i,j) Read(NFctl,*) message1, message2, GAM3D_fop(i,j) Read(NFctl,*) message1, message2, GAM3D_foc(i,j) End Do ! !VSK 05-02-2005; VSK 06-07-2010 Read(NFwqctl,'(//)') TVRCFileCount = TVRCFileCount + 1 Read(NFctl,*) message1, message2, GAM3D_UseTVRCFile(TVRCFileCount) Read(NFctl,*) message1, message2, GAM3D_TVRCFileName(TVRCFileCount) End Do ! ! If(GAM3D_NumTVRCFiles /= 0) Call OpenGAM3DTVRCFiles Return 1000 message = 'Error in Reading Rates and Constants for WQDPM, Please check the control file'C iretw = MessageBox(GetActiveWindow(),message,'GEMSS Model'C,MB_ICONINFORMATION.or.MB_OK) Stop Return Entry AllocateMemoryForGAMVariables ! !Rates and constants variables Allocate (GAM3D_k1r(ngamcs,NUMGAM3DRegions+1), Stat = AllocError) GAM3D_k1r = 0.0d+00 Allocate (GAM3D_Tht_k1r(ngamcs, NUMGAM3DRegions+1), Stat = AllocError) GAM3D_Tht_k1r = 0.0d+00 Allocate (GAM3D_k1c(ngamcs, NUMGAM3DRegions+1), Stat = AllocError) GAM3D_k1c = 0.0d+00 Allocate (GAM3D_Tht_k1c(ngamcs, NUMGAM3DRegions+1), Stat = AllocError) GAM3D_Tht_k1c = 0.0d+00 Allocate (GAM3D_k1d(ngamcs, NUMGAM3DRegions+1), Stat = AllocError) GAM3D_k1d = 0.0d+00 Allocate (GAM3D_Tht_k1d(ngamcs, NUMGAM3DRegions+1), Stat = AllocError) GAM3D_Tht_k1d = 0.0d+00 Allocate (GAM3D_fe(ngamcs,NUMGAM3DRegions+1), Stat = AllocError) GAM3D_fe = 0.0d+00 Allocate (GAM3D_as(ngamcs,NUMGAM3DRegions+1), Stat = AllocError) GAM3D_as = 0.0d+00 Allocate (GAM3D_ZPGMode(ngamcs, NUMGAM3DRegions+1), Stat = AllocError) GAM3D_ZPGMode = 0 Allocate (GAM3D_kgmicro(ngamcs, NUMGAM3DRegions+1), Stat = AllocError) GAM3D_kgmicro = 0.0d+00 Allocate (GAM3D_Tht_kgmicro(ngamcs, NUMGAM3DRegions+1), Stat = AllocError) GAM3D_Tht_kgmicro = 0.0d+00 Allocate (GAM3D_kgmacro(ngamcs, NUMGAM3DRegions+1), Stat = AllocError) GAM3D_kgmacro = 0.0d+00 Allocate (GAM3D_Tht_kgmacro(ngamcs, NUMGAM3DRegions+1), Stat = AllocError) GAM3D_Tht_kgmacro = 0.0d+00 Allocate (GAM3D_fd5(ngamcs,NUMGAM3DRegions+1), Stat = AllocError) GAM3D_fd5 = 0.0d+00 Allocate (GAM3D_fon(ngamcs,NUMGAM3DRegions+1), Stat = AllocError) GAM3D_fon = 0.0d+00 Allocate (GAM3D_fop(ngamcs,NUMGAM3DRegions+1), Stat = AllocError) GAM3D_fop = 0.0d+00 Allocate (GAM3D_foc(ngamcs,NUMGAM3DRegions+1), Stat = AllocError) GAM3D_foc = 0.0d+00 Allocate (GAM3D_ws(ngamcs,NUMGAM3DRegions+1), Stat = AllocError) GAM3D_ws = 0.0d+00 Allocate (GAM3D_kechl(ngamcs,NUMGAM3DRegions+1), Stat = AllocError) GAM3D_kechl = 0.0d+00 Allocate (GAM3D_cchl(ngamcs,NUMGAM3DRegions+1), Stat = AllocError) GAM3D_cchl = 0.0d+00 Allocate (GAM3D_LightModel(ngamcs, NUMGAM3DRegions+1), Stat = AllocError) GAM3D_LightModel = 0 Allocate (GAM3D_ISat(ngamcs,NUMGAM3DRegions+1), Stat = AllocError) GAM3D_ISat = 0.0d+00 Allocate (GAM3D_khn(ngamcs,NUMGAM3DRegions+1), Stat = AllocError) GAM3D_khn = 0.0d+00 Allocate (GAM3D_khp(ngamcs,NUMGAM3DRegions+1), Stat = AllocError) GAM3D_khp = 0.0d+00 Allocate (GAM3D_stf(ngamcs,NUMGAM3DRegions+1), Stat = AllocError) GAM3D_stf = 0.0d+00 Allocate (GAM3D_khst(ngamcs,NUMGAM3DRegions+1), Stat = AllocError) GAM3D_khst = 0.0d+00 Allocate (GAM3D_stMethod(ngamcs, NUMGAM3DRegions+1), Stat = AllocError) GAM3D_stMethod = 0 Allocate (GAM3D_tm(ngamcs,NUMGAM3DRegions+1), Stat = AllocError) GAM3D_tm = 0.0d+00 Allocate (GAM3D_ktg1(ngamcs,NUMGAM3DRegions+1), Stat = AllocError) GAM3D_ktg1 = 0.0d+00 Allocate (GAM3D_ktg2(ngamcs,NUMGAM3DRegions+1), Stat = AllocError) GAM3D_ktg2 = 0.0d+00 Allocate (GAM3D_kke(ngamcs,NUMGAM3DRegions+1), Stat = AllocError) GAM3D_kke = 0.0d+00 ! !Computed variables Allocate (GAM3D_dr(ngamcs), Stat = AllocError) GAM3D_dr = 0.0d+00 Allocate (GAM3D_gp(ngamcs), Stat = AllocError) GAM3D_gp = 0.0d+00 Allocate (GAM3D_dd(ngamcs), Stat = AllocError) GAM3D_dd = 0.0d+00 Allocate (GAM3D_pnh3(ngamcs), Stat = AllocError) GAM3D_pnh3 = 0.0d+00 Allocate (GAM3D_rcchl(ngamcs), Stat = AllocError) GAM3D_rcchl = 0.0d+00 Allocate (GAM3D_gp(ngamcs), Stat = AllocError) GAM3D_gp = 0.0d+00 Allocate (GAM3D_kess(ngamcs), Stat = AllocError) GAM3D_kess = 0.0d+00 Allocate (GAM3D_isc(ngamcs), Stat = AllocError) GAM3D_isc = 0.0d+00 Allocate (GAM3D_nl(ngamcs), Stat = AllocError) GAM3D_nl = 0.0d+00 Allocate (GAM3D_pl(ngamcs), Stat = AllocError) GAM3D_pl = 0.0d+00 Allocate (GAM3D_apc(ngamcs), Stat = AllocError) GAM3D_apc = 0.0d+00 Allocate (GAM3D_fn(ngamcs), Stat = AllocError) GAM3D_fn = 0.0d+00 Allocate (GAM3D_ft(ngamcs), Stat = AllocError) GAM3D_ft = 0.0d+00 Allocate (GAM3D_fi(ngamcs), Stat = AllocError) GAM3D_fi = 0.0d+00 Allocate (GAM3D_ftox(ngamcs), Stat = AllocError) GAM3D_ftox = 0.0d+00 Allocate (GAM3D_pnh3(ngamcs), Stat = AllocError) GAM3D_pnh3 = 0.0d+00 Allocate (GAM3D_SumPhyt(n1+1), Stat = AllocError) GAM3D_SumPhyt = 0.0d+00 Allocate (GAM3D_ri(km_p+1), Stat = AllocError) GAM3D_ri = 0.0d+00 Allocate (GAM3D_ggraze(ngamcs), Stat = AllocError) GAM3D_ggraze = 0.0d+00 Allocate (GAM3D_gmicro(ngamcs), Stat = AllocError) GAM3D_gmicro = 0.0d+00 Allocate (GAM3D_gmacro(ngamcs), Stat = AllocError) GAM3D_gmacro = 0.0d+00 Allocate(GAM3D_UseNutrientLimit(NUMGAM3DRegions+1), Stat = AllocError) Allocate(GAM3D_UseTempLimit(NUMGAM3DRegions+1), Stat = AllocError) Allocate(GAM3D_UseSalineToxicLimit(NUMGAM3DRegions+1), Stat = AllocError) Allocate(GAM3D_UseLightLimit(NUMGAM3DRegions+1), Stat = AllocError) Allocate(GAM3D_UDC_LimitingFactor(8,5)) Allocate(GAM3D_UDC_Output(2,13)) GAM3D_UDC_LimitingFactor = 0.d00 GAM3D_UDC_Output = 0.d00 Allocate(GAM_3D_fn(n1+1,km_p+1,ngamcs), GAM_3D_fi(n1+1,km_p+1,ngamcs), GAM_3D_ft(n1+1,km_p+1,ngamcs)) Allocate(GAM_3D_ftox(n1+1,km_p+1,ngamcs), GAM_3D_fnet(n1+1,km_p+1,ngamcs)) GAM_3D_fn = 0.d+00 GAM_3D_fi = 0.d+00 GAM_3D_ft = 0.d+00 GAM_3D_ftox = 0.d+00 GAM_3D_fnet = 0.d+00 Allocate(GAM_3D_N_lim(n1+1,km_p+1,ngamcs), Stat = AllocError) Allocate(GAM_3D_P_lim(n1+1,km_p+1,ngamcs), Stat = AllocError) Allocate(GAM_3D_T_lim(n1+1,km_p+1,ngamcs), Stat = AllocError) GAM_3D_N_lim = 0.0d+00 GAM_3D_P_lim = 0.0d+00 GAM_3D_T_lim = 0.0d+00 Allocate(GAM_3D_PPROD(n1+1,km_p+1,ngamcs), Stat = AllocError) GAM_3D_PPROD = 0.0 Return Entry ComputeDepthRelatedSolarRadiation RegionNum = 1 If(NUMGAM3DRegions > 0) RegionNum = GAM3DRegionStatus(i,j) + 1 Depth = 0.0 kt = ktwb(cwbn(i,j)) d11 = dzk(kt) - z(n) GAM3D_ri = 0.0 Do kn = kt, k0(i,j) PhytoConc = 0.0 Do id = 1, ngamcs PhytoConc = PhytoConc + c(n,kn,I_GAM(id)) End Do Depth = Depth + d11 Depth1 = Depth - d11/2.0 GAM3D_SumPhyt(n) = GAM3D_SumPhyt(n) + PhytoConc*d11 Do id = 1, ngamcs GAM3D_ke = GAM3D_kke(id,RegionNum) + GAM3D_kechl(id,RegionNum)*GAM3D_SumPhyt(n)/GAM3D_cchl(id,RegionNum) End Do GAM3D_ri(kn) = SolRad*exp(-1.0*GAM3D_ke*Depth1) d11 = dzk(kn+1) End Do !kn Return Entry SetGAMSSTermsOutsideWQM Do n = 1, n1 ! !Skipping all nonactive and boundary padded cells (used for open boundary condition only) If(nm(n) /= 1) Cycle i = i1(n) j = j1(n) RegionNum = 1 If(NUMGAM3DRegions > 0) RegionNum = GAM3DRegionStatus(i,j) + 1 ! !VSK: 06-24-2010 - To handle values coming from met spatially varying boundary condition If(MaxNumMetBcs > 0) SolRad = MetBCrs(dsgdr(CellMetBCNum(n))) kt = ktwb(cwbn(i,j)) d11 = dzk(kt) - z(n) SetTop = 0.0d+00 Depth = 0.0 CellArea = dxx(i,j)*dyy(i,j) Call ComputeDepthRelatedSolarRadiation Do k = kt, k0(i,j) ! !Wall boundary If(m(n,k) == 0) Cycle CellVolume = dxx(i,j)*dyy(i,j)*d11 Call GAMSSTermsInsideWQM SetTop = 1.0 d11 = dzk(k+1) End Do End Do Return Entry GAMSSTermsInsideWQM ! !Switch to control SumPhyt to be initialized once If(InsideGAM == 0) GAM3D_SumPhyt = 0.0d+00 InsideGAM = 1 ! ! RegionNum = 1 Temp20 = c(n,k,I_Temp) - 20.0 If(NUMGAM3DRegions > 0) RegionNum = GAM3DRegionStatus(i,j) + 1 Call ReadGAM3DTVRCFiles(RegionNum) If(UseLOTTMethod == 1) Call ComputeDepthRelatedSolarRadiation ! !Light limitation GAM3D_fi = 1.0 If(GAM3D_UseLightLimit(RegionNum) == 1) Then Do id = 1, ngamcs Select Case(GAM3D_LightModel(id,RegionNum)) ! !Half Saturation Case(1) If(GAM3D_ISat(id,RegionNum) == 0) Then GAM3D_fi(id) = 1.0 Else If(UseLOTTMethod == 1) Then GAM3D_fi(id) = GAM3D_ri(k)/(GAM3D_ISat(id,RegionNum) + GAM3D_ri(k)) Else !QUAL2Kw depth-integrated form of half sat eqn in this layer !phil = 1 / (ke * depth(i)) * Log((Isat_rch(i) + Iat(i)) / (Isat_rch(i) + Iat(i) * Exp(-ke * depth(i)))) GAM3D_fi(id) = 1.0 / KeCalc(n,k) * Log((GAM3D_ISat(id,RegionNum) + & RTopPAR(n,k)) / (GAM3D_ISat(id,RegionNum) + RTopPAR(n,k) * RExtPAR(n,k))) End if End If ! !Smith's function Case(2) If(GAM3D_ISat(id,RegionNum) == 0) Then GAM3D_fi(id) = 1.0 Else If(UseLOTTMethod == 1) Then GAM3D_fi(id) = GAM3D_ri(k)/sqrt(GAM3D_ISat(id,RegionNum)**2.0 + GAM3D_ri(k)**2.0) Else !QUAL2Kw depth-integrated form of Smith eqn in this layer !num = Iat(i) / Isat_rch(i) + Sqr(1 + (Iat(i) / Isat_rch(i)) ^ 2) !den = Iat(i) * Exp(-ke * depth(i)) / Isat_rch(i) + Sqr(1 + (Iat(i) * Exp(-ke * depth(i)) / Isat_rch(i)) ^ 2) !phil = 1 / (ke * depth(i)) * Log(num / den) num = RTopPAR(n,k) / GAM3D_ISat(id,RegionNum) + Sqrt(1.0 + (RTopPAR(n,k) / GAM3D_ISat(id,RegionNum)) ** 2.0) den = RTopPAR(n,k) * RExtPAR(n,k) / GAM3D_ISat(id,RegionNum) + & Sqrt(1.0 + (RTopPAR(n,k) * RExtPAR(n,k) / GAM3D_ISat(id,RegionNum)) ** 2.0) GAM3D_fi(id) = 1.0 / KeCalc(n,k) * Log(num / den) End if End If ! !Steel's Equation Case(3) If(GAM3D_ISat(id,RegionNum) == 0) Then GAM3D_fi(id) = 1.0 Else If(UseLOTTMethod == 1) Then GAM3D_fi(id) = (GAM3D_ri(k)/GAM3D_ISat(id,RegionNum))*exp(1.0 - GAM3D_ri(k)/GAM3D_ISat(id,RegionNum)) Else !QUAL2Kw depth-integrated form of Steele eqn in this layer !alpha0 = Iat(i) / Isat_rch(i) !alpha1 = Iat(i) / Isat_rch(i) * Exp(-ke * depth(i)) !phil = Exp(1) * (Exp(-alpha1) - Exp(-alpha0)) / (ke * depth(i)) alpha0 = RTopPAR(n,k) / GAM3D_ISat(id,RegionNum) alpha1 = RTopPAR(n,k) / GAM3D_ISat(id,RegionNum) * RExtPAR(n,k) GAM3D_fi(id) = Exp(1.0) * (Exp(-alpha1) - Exp(-alpha0)) / KeCalc(n,k) End If End If End Select End Do End If ! !Nutrient limitations !nitrogen availability for algal growth ftmp = c(n,k,I_NH3) + c(n,k,I_NO3) Do id = 1, ngamcs If(GAM3D_khn(id,RegionNum) == 0)Then GAM3D_nl(id) = 1.0 Else GAM3D_nl(id) = ftmp/(GAM3D_khn(id,RegionNum) + ftmp) End If End Do ! !Phosphorus availability for algal growth Do id = 1, ngamcs If(GAM3D_khp(id,RegionNum) == 0)Then GAM3D_pl(id) = 1.0 Else GAM3D_pl(id) = c(n,k,I_PO4)/(GAM3D_khp(id,RegionNum) + c(n,k,I_PO4)) End If End Do ! ! GAM3D_fn = 1.0 If(GAM3D_UseNutrientLimit(RegionNum) == 1) Then Do id = 1, ngamcs GAM3D_fn(id) = min(GAM3D_nl(id),GAM3D_pl(id)) End Do End If ! !Temperature effects GAM3D_ft = 1.0 If(GAM3D_UseTempLimit(RegionNum) == 1) Then Do id = 1, ngamcs If (GAM3D_Tht_k1c(id,RegionNum) .gt. 1.0) Then GAM3D_ft(id) = GAM3D_Tht_k1c(id,RegionNum)**Temp20 Else If (c(n,k,I_Temp) < GAM3D_tm(id,RegionNum)) Then GAM3D_ft(id) = exp(-GAM3D_ktg1(id,RegionNum)*(c(n,k,I_Temp) - GAM3D_tm(id,RegionNum))**2) Else GAM3D_ft(id) = exp(-GAM3D_ktg2(id,RegionNum)*(GAM3D_tm(id,RegionNum) - c(n,k,I_Temp))**2) End If End If End Do End If ! !Saline effects GAM3D_ftox = 1.0 If(GAM3D_UseSalineToxicLimit(RegionNum) == 1) Then Do id = 1,ngamcs stox = dmax1(0.0d+00,c(n,k,I_Saln)) Select Case(GAM3D_stMethod(id,RegionNum)) ! !non-dimensional factor Case(1) GAM3D_ftox(id) = GAM3D_khst(id,RegionNum)**2.0/(GAM3D_khst(id,RegionNum)**2.0 + stox**2.0) ! !dimensional 1/sec Case(2) GAM3D_ftox(id) = GAM3D_stf(id,RegionNum)*0.5*(1.0 + dtanh(stox-GAM3D_khst(id,RegionNum))) End Select End Do End If ! ! !Production Do id = 1, ngamcs ! !Ambrose Bug Fix If(GAM3D_stMethod(id,RegionNum) == 1) Then If(UseLOTTMethod == 1) Then AlgaeGrwthNetLimit = (dmin1(GAM3D_fn(id),GAM3D_fi(id),GAM3D_ft(id),GAM3D_ftox(id))) Else AlgaeGrwthNetLimit = GAM3D_fn(id)*GAM3D_fi(id)*GAM3D_ft(id)*GAM3D_ftox(id) End if GAM3D_gp(id) = GAM3D_k1c(id,RegionNum)*AlgaeGrwthNetLimit Else If(GAM3D_stMethod(id,RegionNum) == 2) Then AlgaeGrwthNetLimit = GAM3D_fn(id)*GAM3D_fi(id)*GAM3D_ft(id) GAM3D_gp(id) = GAM3D_k1c(id,RegionNum)*AlgaeGrwthNetLimit - GAM3D_ftox(id) End If GAM3D_pnh3(id) = c(n,k,I_NH3)*c(n,k,I_NO3)/((Epsilon + GAM3D_khn(id,RegionNum) + c(n,k,I_NH3))*(Epsilon + GAM3D_khn(id,RegionNum) + c(n,k,I_NO3))) + & c(n,k,I_NH3)*GAM3D_khn(id,RegionNum)/(Epsilon + (c(n,k,I_NH3) + c(n,k,I_NO3))*(GAM3D_khn(id,RegionNum) + c(n,k,I_NO3))) GAM3D_dr(id) = GAM3D_k1r(id,RegionNum)*GAM3D_Tht_k1r(id, RegionNum)**Temp20 GAM3D_dd(id) = GAM3D_k1d(id,RegionNum) !*GAM3D_Tht_k1d(id, RegionNum)**Temp20 ! !GP,VSK: 04-06-2010 GAM_3D_fn(m1(i,j),k,id) = GAM3D_fn(id) !light limitation factor for GAM in cell n layer k GAM_3D_fi(m1(i,j),k,id) = GAM3D_fi(id) GAM_3D_ft(m1(i,j),k,id) = GAM3D_ft(id) GAM_3D_ftox(m1(i,j),k,id) = GAM3D_ftox(id) GAM_3D_fnet(m1(i,j),k,id) = AlgaeGrwthNetLimit !N limitation factor for GAM in cell n layer k GAM_3D_N_lim(m1(i,j),k,id) = GAM3D_nl(id) !P limitation factor for GAM in cell n layer k GAM_3D_P_lim(m1(i,j),k,id) = GAM3D_pl(id) !Temperature limitation and effect factor for GAM in cell n layer k !Ambrose Bug Fix GAM_3D_T_lim(m1(i,j),k,id) = GAM3D_ft(id) End Do ! !Estimate each term in the algal rate equation Do id = 1, ngamcs Call GAMZooplanktonGrazing MAlgGrowth = GAM3D_gp(id)*c(n,k,I_GAM(id)) MAlgResp = - GAM3D_dr(id)*c(n,k,I_GAM(id)) MAlgDeath = - GAM3D_dd(id)*c(n,k,I_GAM(id)) MAlgExrec = - GAM3D_fe(id,RegionNum)*GAM3D_gp(id)*c(n,k,I_GAM(id)) MAlgGraze = - GAM3D_ggraze(id) MAlgSettl = - GAM3D_ws(id,RegionNum)*c(n,k,I_GAM(id))/d1 + & GAM3D_ws(id,RegionNum)*c(n,k-1,I_GAM(id))*SetTop/dzk(k-1) h(n,k,I_GAM(id)) = h(n,k,I_GAM(id)) + (MAlgGrowth + MAlgResp + MAlgDeath + MAlgExrec + MAlgGraze + MAlgSettl)*CellVolume ! !GP, VSK: 05-03-2010 GAM_3D_PProd(m1(i,j),k,id) = MAlgGrowth + MAlgResp + MAlgDeath + MAlgExrec !NH3 NH3FromAlg = GAM3D_dr(id)*anc*c(n,k,I_GAM(id)) NH3ToAlg = GAM3D_gp(id)*anc*GAM3D_pnh3(id)*c(n,k,I_GAM(id)) h(n,k,I_NH3) = h(n,k,I_NH3) + (NH3FromAlg - NH3ToAlg)*CellVolume ! !NO3 NO3ToAlg = GAM3D_gp(id)*anc*(1.0 - GAM3D_pnh3(id))*c(n,k,I_GAM(id)) h(n,k,I_NO3) = h(n,k,I_NO3) - NO3ToAlg*CellVolume ! !PO4 PO4FromAlg = GAM3D_dr(id)*apc*c(n,k,I_GAM(id)) PO4ToAlg = GAM3D_gp(id)*apc*c(n,k,I_GAM(id)) h(n,k,I_PO4) = h(n,k,I_PO4) + (PO4FromAlg - PO4ToAlg)*CellVolume ! !Ambrose Bug Fix If(UseLOTTMethod == 1) Then ! !use the original LOTT study method DOFromAlg = GAM3D_gp(id)*(32./12. + & 0.8*32./12.*(1. - GAM3D_pnh3(id)) + & 0.2*32./12.*( GAM3D_pnh3(id)))*c(n,k,I_GAM(id)) Else !use the WASP EUTRO method adapted from WASP DISSOXYG.FOR !note: phyto biomass is in mgC/L = gC/m^3 !growth of phytoplankton using CO2 and NH3 DOFromAlg = GAM3D_pnh3(id) * GAM3D_gp(id) * c(n,k,I_GAM(id)) * 32. / 12. !growth of phytoplankton using CO2 and NO3 (2NO3 = 2NH3 + 3O2) DOFromAlg = DOFromAlg + (1. - GAM3D_pnh3(id)) * GAM3D_gp(id) * c(n,k,I_GAM(id)) * 32. * (1./12. + 1.5 * anc / 14.) End If DOToAlg = 32./12.*GAM3D_dr(id)*c(n,k,I_GAM(id)) h(n,k,I_DO) = h(n,k,I_DO) + (DOFromAlg - DOToAlg)*CellVolume ! !WQCBM If(iwqc == WQSSTERMS_USING_WQCBM) Then FCBODFromAlg = GAM3D_dd(id)*aoc*GAM3D_foc(id, RegionNum)*GAM3D_fd5(id,RegionNum)*c(n,k,I_GAM(id)) + & GAM3D_gp(id)*aoc*GAM3D_fe(id,RegionNum) h(n,k,I_CBOD_F) = h(n,k,I_CBOD_F) + FCBODFromAlg*CellVolume SCBODFromAlg = GAM3D_dd(id)*aoc*GAM3D_foc(id,RegionNum)*(1 - GAM3D_fd5(id,RegionNum))*c(n,k,I_GAM(id)) h(n,k,I_CBOD_S) = h(n,k,I_CBOD_S) + SCBODFromAlg*CellVolume ! !Ambrose Bug Fix POCFFromAlg = GAM3D_dd(id)*fd9f*(1 - GAM3D_foc(id,RegionNum))*c(n,k,I_GAM(id)) + & GAM3D_ggraze(id)*fg9f h(n,k,I_OC_P_F) = h(n,k,I_OC_P_F) + POCFFromAlg*CellVolume POCSFromAlg = GAM3D_dd(id)*fd9s*(1 - GAM3D_foc(id,RegionNum))*c(n,k,I_GAM(id)) + & GAM3D_ggraze(id)*fg9s h(n,k,I_OC_P_S) = h(n,k,I_OC_P_S) + POCSFromAlg*CellVolume POCRFromAlg = GAM3D_dd(id)*fd9r*(1 - GAM3D_foc(id,RegionNum))*c(n,k,I_GAM(id)) + & GAM3D_ggraze(id)*fg9r h(n,k,I_OC_P_R) = h(n,k,I_OC_P_R) + POCRFromAlg*CellVolume ! !Adding source to ON_D and OP_D from algae death and excretion DONFromAlg = GAM3D_dd(id)*anc*GAM3D_fon(id,RegionNum)*c(n,k,I_GAM(id)) + & GAM3D_gp(id)*anc*GAM3D_fe(id,RegionNum)*c(n,k,I_GAM(id)) h(n,k,I_ON_D) = h(n,k,I_ON_D) + DONFromAlg*CellVolume DOPFromAlg = GAM3D_dd(id)*apc*GAM3D_fop(id,RegionNum)*c(n,k,I_GAM(id)) + & GAM3D_gp(id)*apc*GAM3D_fe(id,RegionNum)*c(n,k,I_GAM(id)) h(n,k,I_OP_D) = h(n,k,I_OP_D) + DOPFromAlg*CellVolume ! !Adding source to ON_P and OP_P from algae death and excretion !Ambrose Bug Fix PONFromAlg = GAM3D_dd(id)*anc*(1.0 - GAM3D_fon(id,RegionNum))*c(n,k,I_GAM(id)) + & GAM3D_ggraze(id)*anc ! ![gN/m3-day] = [1/day] * [gN/gC] * [] * [gC/m3] ! + [gC/m3/day] * [gN/gC] * [] * [gC/m3] h(n,k,I_ON_P) = h(n,k,I_ON_P) + PONFromAlg*CellVolume ![gN/day] = [gN/day] + [gN/m3-day] * [m3] ! !Ambrose Bug Fix POPFromAlg = GAM3D_dd(id)*apc*(1 - GAM3D_fop(id,RegionNum))*c(n,k,I_GAM(id)) + & GAM3D_ggraze(id)*apc ! ![gP/m3-day] = [1/day] * [gP/gC] * [] * [gC/m3] ! + [gC/m3/day] * [gP/gC] * [] * [gC/m3] h(n,k,I_OP_P) = h(n,k,I_OP_P) + POPFromAlg*CellVolume ![gP/day] = [gP/day] [gP/m3-day] * [m3] End If ! !WQDPM If(iwqc == WQSSTERMS_USING_WQDPM) Then DONFromAlg = GAM3D_dd(id)*anc*GAM3D_fon(id,RegionNum)*c(n,k,I_GAM(id)) + & GAM3D_gp(id)*anc*GAM3D_fe(id,RegionNum)*c(n,k,I_GAM(id)) ! ![gN/m3-day] = [1/day] * [gN/gC] * [] * [gC/m3] ! + [1/day] * [gN/gC] * [] * [gC/m3] h(n,k,I_ON_D) = h(n,k,I_ON_D) + DONFromAlg*CellVolume ! ![gN/day] = [gN/day] + [gN/m3-day] * [m3] ! !Ambrose Bug Fix PONFromAlg = GAM3D_dd(id)*anc*(1.0 - GAM3D_fon(id,RegionNum))*c(n,k,I_GAM(id)) + & GAM3D_ggraze(id)*anc ![gN/m3-day] = [1/day] * [gN/gC] * [] * [gC/m3] ! + [gC/m3/day] * [gN/gC] * [] * [gC/m3] h(n,k,I_ON_P) = h(n,k,I_ON_P) + PONFromAlg*CellVolume ! ![gN/day] = [gN/day] + [gN/m3-day] * [m3] DOPFromAlg = GAM3D_dd(id)*apc*GAM3D_fop(id,RegionNum)*c(n,k,I_GAM(id)) + & GAM3D_gp(id)*apc*GAM3D_fe(id,RegionNum)*c(n,k,I_GAM(id)) ! ![gP/m3-day] = [1/day] * [gP/gC] * [] * [gC/m3] ! + [1/day] * [gP/gC] * [] * [gC/m3] h(n,k,I_OP_D) = h(n,k,I_OP_D) + DOPFromAlg*CellVolume ! ![gP/day] = [gP/day] + [gP/m3-day] * [m3] ! !Ambrose Bug Fix POPFromAlg = GAM3D_dd(id)*apc*(1 - GAM3D_fop(id,RegionNum))*c(n,k,I_GAM(id)) + & GAM3D_ggraze(id)*apc ! ![gP/m3-day] = [1/day] * [gP/gC] * [] * [gC/m3] ! + [gC/m3/day] * [gP/gC] * [] * [gC/m3] h(n,k,I_OP_P) = h(n,k,I_OP_P) + POPFromAlg*CellVolume ![gP/day] = [gP/day] + [gP/m3-day] * [m3] End If ! !WQADD3D !Call WQADD3D before GAM If(AddWaterQuality) Then h(n,k,I_LDOM) = h(n,k,I_LDOM) + ((1.0 - Pam)*MAlgDeath + MAlgExrec)*CellVolume ! !Ambrose bug fix !h(n,k,I_RDOM) = h(n,k,I_RDOM) + ( Pam)*MAlgDeath*CellVolume h(n,k,I_LPOM) = h(n,k,I_LPOM) + ( Pam)*MAlgDeath*CellVolume ! !gm/sec h(n,k,I_ALKL) = acc(I_ALKL)*(h(n,k,I_ALKL) + & ( ralkan *MAlgGrowth*(1.0 - prefam)*50000.0 & - ralkaa *MAlgGrowth*( prefam)*50000.0 & + ralkaa *MAlgResp*50000.0)*CellVolume) If(WQADD3DA_cnss(I_TIOC-ncWQADDSt+1,WQADD3DRegionStatus(i1(n),j1(n))+1) == 1) Then ! !Sources and sinks due to Phytoplankton h(n,k,I_TIOC) = acc(I_TIOC)*(h(n,k,I_TIOC) + (rcca*MAlgResp - rcca*MAlgGrowth)*CellVolume) End If End If End Do Return Entry GAMZooplanktonGrazing ! !Zooplankton Grazing Select Case(GAM3D_ZPGMode(id,RegionNum)) ! !g/m^3-day Case(ConstantGrazing) GAM3D_gmicro(id) = GAM3D_kgmicro(id,RegionNum)*GAM3D_Tht_kgmicro(id,RegionNum)**temp20 GAM3D_gmacro(id) = GAM3D_kgmacro(id,RegionNum)*GAM3D_Tht_kgmacro(id,RegionNum)**temp20 GAM3D_ggraze(id) = GAM3D_kgmicro(id,RegionNum) + GAM3D_kgmacro(id,RegionNum) ! !1/day !grazing function by Boatman (10/17/97) Case(LinearGrazing) GAM3D_gmicro(id) = GAM3D_kgmicro(id,RegionNum)*GAM3D_Tht_kgmicro(id,RegionNum)**temp20*c(n,k,I_GAM(id)) GAM3D_gmacro(id) = GAM3D_kgmacro(id,RegionNum)*GAM3D_Tht_kgmacro(id,RegionNum)**temp20*c(n,k,I_GAM(id)) GAM3D_ggraze(id) = GAM3D_gmicro(id) + GAM3D_gmacro(id) ! !(m^3/g-day) !density dependent Case(DensityDependentGrazing) GAM3D_gmicro(id) = GAM3D_kgmicro(id,RegionNum)*c(n,k,I_GAM(id))*GAM3D_Tht_kgmicro(id,RegionNum)**temp20*c(n,k,I_GAM(id)) GAM3D_gmacro(id) = GAM3D_kgmacro(id,RegionNum)*c(n,k,I_GAM(id))*GAM3D_Tht_kgmacro(id,RegionNum)**temp20*c(n,k,I_GAM(id)) GAM3D_ggraze(id) = GAM3D_gmicro(id) + GAM3D_gmacro(id) End Select Return Entry OpenGAM3DTVRCFiles NumTVRCFiles = GAM3D_NumTVRCFiles Allocate(GAM3D_nTVRCclms(NumTVRCFiles), Stat = AllocError) Allocate(GAM3D_iTVRCamp(NumTVRCFiles,256), GAM3D_iTVRCcol(NumTVRCFiles,256), GAM3D_iTVRCunit(NumTVRCFiles,256), Stat = AllocError) Allocate(GAM3D_TVRCValue(2,256), Stat = AllocError) Allocate(GAM3D_TVRCSTime(NumTVRCFiles), Stat = AllocError) Allocate(GAM3D_TVRCETime(NumTVRCFiles), Stat = AllocError) Allocate(GAM3D_TVRCInterp(NumTVRCFiles), Stat = AllocError) Allocate(GAM3D_TVRCMVNumber(NumTVRCFiles), Stat = AllocError) Allocate(GAM3D_EndFileCountKDG(NumTVRCFiles), Stat = AllocError) GAM3D_nTVRCclms = 0 GAM3D_iTVRCamp = 0.0 GAM3D_iTVRCcol = 0 GAM3D_TVRCValue = 0.0 GAM3D_TVRCInterp = 0 GAM3D_TVRCMVNumber = 999999999.0 GAM3D_EndFileCountKDG = 0 Do jdd = 1, NumTVRCFiles If(GAM3D_UseTVRCFile(jdd) == 0) Cycle message = Trim(GAM3D_TVRCFileName(jdd)) If(message(1:len_trim(message)-1) == 'No_Data_File') Cycle file_name = message(1:len_trim(message)-1) Call file_exist(file_name, ierr) If (ierr < 0) Then message = 'Error in opening'//file_name(1:len_trim(file_name))//Char(0) iretw = MessageBox(GetActiveWindow(),message,'GLLVHT Model'C,MB_ICONERROR.or.MB_OK) Write(NFErr,'(a)') message(1:len_trim(message)) GLLVHTError = 1 Return End If Write(*,'(a)') 'Initializing'//file_name(1:len_trim(file_name)) Call GetUnitNumber(NFGAM3D(jdd)) Open (NFGAM3D(jdd), file = file_name, Status='old', SHARED, Action = 'READ') ReWind(NFGAM3D(jdd)) message = '' Read (NFGAM3D(jdd),'(a)') message VersionCheck = 0 VersionCheck = 0 If(Index(message,'V1') /= 0) VersionCheck = 1 If(Index(message,'V2') /= 0) VersionCheck = 2 If(Index(message,'V3') /= 0) VersionCheck = 3 If(Index(message,'V4') /= 0) VersionCheck = 4 Write(*,*) '.KDG TVRC File Number =', jdd, 'Version Number = ', VersionCheck Do While (.true.) Read (NFGAM3D(jdd),'(a)') message If(Index(message,'$') == 0) Exit End Do BackSpace(NFGAM3D(jdd)) If(VersionCheck >= 1) Read(NFGAM3D(jdd),*) Value1, Value2 !Read(NFGAM3D(jdd),*) TVDMVNumber(jdd) Read(NFGAM3D(jdd),*) BytVal1 !use only one bin Read(NFGAM3D(jdd),*) GAM3D_nTVRCclms(jdd) Do i = 1, GAM3D_nTVRCclms(jdd) Read(NFGAM3D(jdd),*) GAM3D_iTVRCCol(jdd,i), BytVal1, BytVal2, GAM3D_iTVRCAmp(jdd,i), BytVal3, message If(GAM3D_iTVRCCol(jdd,i) == SkipTVDColumnValue) Cycle GAM3D_iTVRCUnit(jdd,i) = BytVal2 End Do ! ! Do While (.true.) Read (NFGAM3D(jdd),'(a)') message If(index(message,'$') == 0) Exit End Do Backspace(NFGAM3D(jdd)) ! !Bin was removed on 08-27-2007 VSK Read(NFGAM3D(jdd),*,iostat = istat) tvdsyear, tvdsmonth, tvdsday, tvdshour, tvdsmin,& (GAM3D_TVRCValue(1,i), i = 1, GAM3D_nTVRCclms(jdd)) Call seterrormessage(istat,NFGAM3D(jdd),GAM3D_TVRCFileName(jdd)) If(istat > 0) Then GLLVHTError = 1 Return End If If(istat < 0) GAM3D_EndFileCountKDG(jdd) = GAM3D_EndFileCountKDG(jdd) + 1 GAM3D_TVRCSTime(jdd) = dttm2julian(tvdsyear, tvdsmonth, tvdsday, tvdshour, tvdsmin) ! !Bin was removed on 08-27-2007 VSK Read(NFGAM3D(jdd),*,iostat = istat) tvdsyear, tvdsmonth, tvdsday, tvdshour, tvdsmin,& (GAM3D_TVRCvalue(2,i), i = 1, GAM3D_nTVRCclms(jdd)) Call seterrormessage(istat,NFGAM3D(jdd),GAM3D_TVRCFileName(jdd)) If(istat > 0) Then GLLVHTError = 1 Return End If If(istat < 0) GAM3D_EndFileCountKDG(jdd) = GAM3D_EndFileCountKDG(jdd) + 1 BackSpace(NFGAM3D(jdd)) GAM3D_TVRCETime(jdd) = dttm2julian(tvdsyear, tvdsmonth, tvdsday, tvdshour, tvdsmin) If (mdltime < GAM3D_TVRCSTime(jdd)) Then Write(NFlog,'(a)') 'TVDS Error: Model start time is < Rates and Constants TV file start time' Write(NFlog,'(a)') 'File Name: '//GAM3D_TVRCFileName(jdd) Write(NFlog,'(a)') 'Algae Model' Write(NFlog,'(/)') Write(NFcle,'(a)') 'TVDS Error: Model start time is < Rates and Constants TV file start time' Write(NFcle,'(a)') 'File Name: '//GAM3D_TVRCFileName(jdd) Write(NFcle,'(a)') 'Algae Model' Write(NFcle,'(/)') End If End Do Return Entry ReadGAM3DTVRCFiles(jd) If(GAM3D_NumTVRCFiles == 0) Return If(.Not. GAM3D_UseTVRCFile(jd)) Return Do While (.true. .and. EndFileCountWDG(jd) <= 1) ! ! If(MdlTime >= GAM3D_TVRCSTime(jd) .and. MdlTime <= GAM3D_TVRCETime(jd)) Then !SP 10/27/2007 added to re-read the values Backspace(NFGAM3D(jd)) Read(NFGAM3D(jd),*,iostat=istat) tvdsyear, tvdsmonth, tvdsday, tvdshour, tvdsmin,& (GAM3D_TVRCvalue(1,nci), nci = 1, GAM3D_nTVRCclms(jd)) Read(NFGAM3D(jd),*,iostat=istat) tvdsyear, tvdsmonth, tvdsday, tvdshour, tvdsmin,& (GAM3D_TVRCvalue(2,nci), nci = 1, GAM3D_nTVRCclms(jd)) Backspace(NFGAM3D(jd)) !End SP 10/27/2007 added to re-read the values Factor = 0.0 Select Case(GAM3D_TVRCInterp(jd)) Case(0) Factor = 0.0 Case(1) Factor = (MdlTime - GAM3D_TVRCSTime(jd))/(GAM3D_TVRCETime(jd) - GAM3D_TVRCSTime(jd)) Case(2) Factor = 1.0 End Select ! !Linear interpolation in both depth and time Do nci = 1,GAM3D_NTVRCclms(jd) Value1 = GAM3D_TVRCvalue(1,nci) Value2 = GAM3D_TVRCvalue(2,nci) If(Value1 /= GAM3D_TVRCMVNumber(jd) .and. Value2 /= GAM3D_TVRCMVNumber(jd)) Then Value = Factor*Value2 + (1.0 - Factor)*Value1 Else If(Value1 == GAM3D_TVRCMVNumber(jd) .and. Value2 /= GAM3D_TVRCMVNumber(jd)) Then Value = Value2 Else If(Value1 /= GAM3D_TVRCMVNumber(jd) .and. Value2 == GAM3D_TVRCMVNumber(jd)) Then Value = Value1 End If If(GAM3D_iTVRCcol(jd,nci) == SkipTVDColumnValue) Cycle nj = GAM3D_iTVRCcol(jd,nci)/(ngamcs + Epsilon) ni = GAM3D_iTVRCcol(jd,nci) - nj*ngamcs + 1 Select Case(nj) Case(1) GAM3D_k1r(ni,RegionNum) = RateConversion(Value, GAM3D_iTVRCUnit(jd,nci)) Case(2) GAM3D_Tht_k1r(ni,RegionNum) = Value Case(3) GAM3D_k1c(ni,RegionNum) = RateConversion(Value, GAM3D_iTVRCUnit(jd,nci)) Case(4) GAM3D_Tht_k1c(ni,RegionNum) = Value Case(5) GAM3D_k1d(ni,RegionNum) = RateConversion(Value, GAM3D_iTVRCUnit(jd,nci)) Case(6) GAM3D_Tht_k1d(ni,RegionNum) = Value Case(7) GAM3D_fe(ni,RegionNum) = Value Case(8) GAM3D_as(ni,RegionNum) = Value Case(9) GAM3D_ws(ni,RegionNum) = Value Case(10) GAM3D_ZPGMode(ni,RegionNum) = Value Case(11) GAM3D_kgmicro(ni,RegionNum) = RateConversion(Value, GAM3D_iTVRCUnit(jd,nci)) Case(12) GAM3D_Tht_kgmicro(ni,RegionNum) = Value Case(13) GAM3D_kgmacro(ni,RegionNum) = RateConversion(Value, GAM3D_iTVRCUnit(jd,nci)) Case(14) GAM3D_kgmacro(ni,RegionNum) = Value Case(15) GAM3D_Tht_kgmacro(ni,RegionNum) = Value Case(16) GAM3D_cchl(ni,RegionNum) = Value Case(17) GAM3D_LightModel(ni,RegionNum) = Value Case(19) GAM3D_kke(ni,RegionNum) = Value Case(20) GAM3D_kechl(ni,RegionNum) = Value Case(21) GAM3D_ISat(ni,RegionNum) = LightConversion(Value, GAM3D_iTVRCUnit(jd,nci)) Case(22) GAM3D_khn(ni,RegionNum) = Value Case(23) GAM3D_khp(ni,RegionNum) = Value Case(24) GAM3D_stMethod(ni,RegionNum) = Value Case(25) GAM3D_stf(ni,RegionNum) = RateConversion(Value, GAM3D_iTVRCUnit(jd,nci)) Case(26) GAM3D_khst(ni,RegionNum) = Value Case(27) GAM3D_tm(ni,RegionNum) = Value Case(28) GAM3D_ktg1(ni,RegionNum) = Value Case(29) GAM3D_ktg2(ni,RegionNum) = Value Case(30) GAM3D_fd5(ni,RegionNum) = Value Case(31) GAM3D_fon(ni,RegionNum) = Value Case(32) GAM3D_fop(ni,RegionNum) = Value Case(33) GAM3D_foc(ni,RegionNum) = Value End Select End Do Exit Else ! !vsk 01/04/00 If(GAM3D_TVRCSTime(jd) > MdlTime) Return Read(NFGAM3D(jd),*,iostat=istat) tvdsyear, tvdsmonth, tvdsday, tvdshour, tvdsmin,& (GAM3D_TVRCvalue(1,nci), nci = 1, GAM3D_nTVRCclms(jd)) Call seterrormessage(istat,NFGAM3D(jd),GAM3D_TVRCFileName(jd)) If(istat < 0) GAM3D_EndFileCountKDG(jd) = GAM3D_EndFileCountKDG(jd) + 1 If(istat > 0) then GLLVHTError = 1 Return End If GAM3D_TVRCSTime(jd) = dfloat(dttm2julian(tvdsyear, tvdsmonth, tvdsday, tvdshour, tvdsmin)) Read(NFGAM3D(jd),*,iostat=istat) tvdsyear, tvdsmonth, tvdsday, tvdshour, tvdsmin,& (GAM3D_TVRCvalue(2,nci), nci = 1, GAM3D_nTVRCclms(jd)) Backspace(NFGAM3D(jd)) Call seterrormessage(istat,NFGAM3D(jd),GAM3D_TVRCFileName(jd)) If(istat < 0) GAM3D_EndFileCountKDG(jd) = GAM3D_EndFileCountKDG(jd) + 1 If(istat > 0) Then GLLVHTError = 1 Return End If GAM3D_TVRCETime(jd) = dfloat(dttm2julian(tvdsyear, tvdsmonth, tvdsday, tvdshour, tvdsmin)) End If End Do !jd Return Entry WriteGAM3DParametersToSnapShot Write(NFSnp,'(/)') Write(NFSnp,'(a)') & '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@' Write(NFSnp,'(a)') & ' GEMSS-GAM ' Write(NFSnp,'(a)') & ' Generalized Algae Model Kinetics Rates and Constants ' Write(NFSnp,'(a)') & '@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@' Do j = 1, NumGAM3DRegions + 1 Write(NFSnp,'(/)') Write(NFSnp,'(a)') & '************************************************************************' If(j == 1) Then Write(NFSnp,'(a)') 'Region: Whole Waterbody' Else Write(NFSnp,'(a,a)') 'Region: ', GAM3DRegionName(j) End If Write(NFSnp,'(a)') & '************************************************************************' Write(NFSnp,'(/)') Do i = 1, ngamcs message = '' Write(NFSnp,'(a)') & '########################################################################' message = 'Rates and Constants For ' Write(message,'(a,a)') & message(1:len_trim(message)), cnm(i)(1:len_trim(cnm(I_GAM(id)))) Write(NFSnp,'(a)') message(1:len_trim(message)) Write(NFSnp,'(a)') & '########################################################################' If(GAM3D_UseNutrientLimit(j) == 1) Then Write(NFSnp,'(a,a,a)') & 'Use nurtient limit =', ' Yes',' ' Else Write(NFSnp,'(a,a,a)') & 'Use nurtient limit =', ' No',' ' End If If(GAM3D_UseTempLimit(j) == 1) Then Write(NFSnp,'(a,a,a)') & 'Use temperature limit =', ' Yes',' ' Else Write(NFSnp,'(a,a,a)') & 'Use temperature limit =', ' No',' ' End If If(GAM3D_UseSalineToxicLimit(j) == 1) Then Write(NFSnp,'(a,a,a)') & 'Use salinity limit =', ' Yes',' ' Else Write(NFSnp,'(a,a,a)') & 'Use salinity limit =', ' No',' ' End If If(GAM3D_UseLightLimit(j) == 1) Then Write(NFSnp,'(a,a,a)') & 'Use light limit =', ' Yes',' ' Else Write(NFSnp,'(a,a,a)') & 'Use light limit =', ' No',' ' End If Write(NFSnp,'(a,e13.6,a)') & 'k1r, Resipiration rate at 20 C =', GAM3D_k1r(i,j), ' 1/sec' Write(NFSnp,'(a,e13.6,a)') & 'Tht_k1r, Temperature coeffcient for k1r =', GAM3D_Tht_k1r(i,j), ' ' Write(NFSnp,'(a,e13.6,a)') & 'k1c, Growth rate at 20 C =', GAM3D_k1c(i,j), ' 1/sec' Write(NFSnp,'(a,e13.6,a)') & 'Tht_k1c, Temperature coeffcient for k1c =', GAM3D_Tht_k1c(i,j), ' ' Write(NFSnp,'(a,e13.6,a)') & 'k1d, Growth rate at 20 C =', GAM3D_k1d(i,j), ' 1/sec' Write(NFSnp,'(a,e13.6,a)') & 'fe, Excretion fraction =', GAM3D_fe(i,j), ' ' Write(NFSnp,'(a,e13.6,a)') & 'as, Assimilation efficiency of zooplankton grazing =', GAM3D_as(i,j), ' ' Write(NFSnp,'(a,e13.6,a)') & 'ws, Settling velocity =', GAM3D_ws(i,j), ' m/sec' ! ! Select Case(GAM3D_ZPGMode(i,j)) ! ! Case(1) Write(NFSnp,'(a,a13,a)') & 'Zooplankton grazing type =', ' Constant',' ' ! ! Case(2) Write(NFSnp,'(a,a13,a)') & 'Zooplankton grazing type =', ' Linear',' ' ! Case(3) Write(NFSnp,'(a,a16,a)') & 'Zooplankton grazing type =', ' Density Dependent',' ' End Select Write(NFSnp,'(a,e13.6,a)') & 'kgmicro, Graing rate due to zooplankton =', GAM3D_kgmicro(i,j),' 1/sec' Write(NFSnp,'(a,e13.6,a)') & 'Tht_kgmicro, Temperature coefficient for zooplankton grazing rate =', GAM3D_Tht_kgmicro(i,j),' ' Write(NFSnp,'(a,e13.6,a)') & 'kgmacro, Graing rate due to zooplankton =', GAM3D_kgmacro(i,j),' 1/sec' Write(NFSnp,'(a,e13.6,a)') & 'Tht_kgmacro, Temperature coefficient for zooplankton grazing rate =', GAM3D_Tht_kgmacro(i,j),' ' Write(NFSnp,'(a,e13.6,a)') & 'cchl, Carbon to chlorophyll ratio =', GAM3D_cchl(i,j),' gC/gChl-a' Select Case(GAM3D_LightModel(i,j)) ! ! Case(1) Write(NFSnp,'(a,a13,a)') & 'Light model used for algal growth =', 'Half Saturation', ' ' ! Case(2) Write(NFSnp,'(a,a13,a)') & 'Light model used for algal growth =', 'Full Saturation', ' ' ! Case(3) Write(NFSnp,'(a,a13,a)') & 'Light model used for algal growth =', 'No Saturation', ' ' End Select Write(NFSnp,'(a,e13.6,a)') & 'kke, Light extinction coefficient =', GAM3D_kke(i,j), ' ' Write(NFSnp,'(a,e13.6,a)') & 'kechl, Light attenuation coefficient =', GAM3D_kechl(i,j), ' m^2/mg' Write(NFSnp,'(a,e13.6,a)') & 'ISat, Light constant =', GAM3D_ISat(i,j), ' W/m^2',' ' Write(NFSnp,'(a,e13.6,a)') & 'khn, Constant for algae nitrogen uptake =', GAM3D_khn(i,j), ' gm N/m^3' Write(NFSnp,'(a,e13.6,a)') & 'khp, Constant for algae phosphorous uptake =', GAM3D_khp(i,j), ' gm P/m^3' ! !Salinity Toxicity Select Case(GAM3D_stMethod(i,j)) ! ! Case(1) Write(NFSnp,'(a,a13,a)') & 'Salinity toxicity is computed using =', ' Equation 1',' ' ! ! Case(2) Write(NFSnp,'(a,a13,a)') & 'Salinity toxicity is computed using =', ' Equation 2',' ' End Select ! ! Write(NFSnp,'(a,e13.6,a)') & 'stf, Maximum mortality due to salinity toxicity =', GAM3D_stf(i,j), ' 1/sec' Write(NFSnp,'(a,e13.6,a)') & 'khst, Salinity at which toxicity is half the maximum value =', GAM3D_khst(i,j), ' ppt' Write(NFSnp,'(a,e13.6,a)') & 'tm, Optimum temperature for algae growth =', GAM3D_tm(i,j), ' 1/sec' Write(NFSnp,'(a,e13.6,a)') & 'ktg1, Suboptimal temperature effect for algal growth =', GAM3D_ktg1(i,j), ' C' Write(NFSnp,'(a,e13.6,a)') & 'ktg2, Superoptimal temperature effect for algal growth =', GAM3D_ktg2(i,j), ' C' Write(NFSnp,'(a,e13.6,a)') & 'fd5, Fraction of dead phytoplankton recycled to fast CBOD =', GAM3D_fd5(i,j), ' ' Write(NFSnp,'(a,e13.6,a)') & 'fon, Organic nitrogen from dead algae =', GAM3D_fon(i,j), ' ' Write(NFSnp,'(a,e13.6,a)') & 'fop, Organic phosphorus from dead aglage =', GAM3D_fop(i,j), ' ' Write(NFSnp,'(a,e13.6,a)') & 'foc, Organic carbon from dead algae =', GAM3D_foc(i,j), ' ' End Do End Do Return End Subroutine GAMSubs